perm filename SEG0.SAI[SYS,HE] blob
sn#022306 filedate 1973-01-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00019 PAGES
C00002 00002 ENTRY DUMMY
C00003 00003 α GLOBAL DATA MAKER
C00008 00004 α DISKOUT
C00012 00005 α ANGLE
C00014 00006 α VERT, DIST, PARALLEL
C00017 00007 α COLINEAR
C00020 00008 α TJOINTS
C00023 00009 α ARROWS
C00026 00010 α WHYS
C00028 00011 α CONVEX
C00032 00012 α ELZ
C00034 00013 α XZANDKZ
C00035 00014 α K_JOINT
C00038 00015 α X_JOINT
C00043 00016 α xzandkz - execution
C00046 00017 α INHIBIT
C00048 00018 α GOODTZ4BAD
C00051 00019 α MERGE_NODE
C00053 ENDMK
C⊗;
ENTRY DUMMY;
BEGIN "SEG0"
REQUIRE 100 PNAMES;
REQUIRE 100 NEW_ITEMS;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "CPXSYM.AUX[SYS,HE]" SOURCE_FILE;
REQUIRE "SEGCOM.AUX[SYS,HE]" SOURCE_FILE;
REQUIRE "SEGDPY.HDR[SYS,HE]" SOURCE_FILE;
DEFINE
FIRST1=<8>,ID=<7>,
GETS1=<STRN←INPUT(FILE,FIRST1);STRN←INPUT(FILE,ID)>,
GETS=<S←INPUT(FILE,FIRST1); S←INPUT(FILE,ID)>;
α EXTERNALS;
ESP GENSYM(REAL ITEMVAR X);
ESP PRINTNAME(ITEMVAR X);
α GLOBAL DATA MAKER
TEMPORARY PROCEDURE
reads the input file and puts the data into the global model.
This will eventually be done by EDGE before calling COMPLEX.
For debugging, if ¬YES_EDGE then ask for input file.
;
INTERNAL PROCEDURE DATA_MAKER;
BEGIN "DATA MAKER"
LABEL INLAB;
INTEGER BREAK,EOF,FILE,II,I,J,K,NUMBER,PATHS,FLAG,FLAGH,FLAGT;
INTEGER NUMOBJ,OBJ,SYM,numreg;
STRING FILNAM,DEV,STRN,tstr;
ITEMVAR S;
SAFE REAL ARRAY CAMARY[1:10,1:3];
SAFE REAL ARRAY ITEMVAR GH,GT,GV,XF;
INTEGER ITEMVAR GL;
ITEMVAR GR;
LIST LIST0;
LIST ITEMVAR PERI;
define lot=<1>;
SETBREAK(LOT,'12,'15,"INS");
INLAB: TYPE "ASSUMING DEVICE = DSK" EOM;
DEV←"DSK";
TYPE "FILE NAME" EOM;
FILNAM←INCHWL;
FILE←7;
OPEN(7,DEV,0,2,0,120,BREAK,EOF);
LOOKUP(7,FILNAM,I);
IF I≠0
THEN BEGIN
TYPE "FILE NOT FOUND" EOM;
RELEASE (7);
GO TO INLAB;
END;
tstr←input(file,lot);
numobj←intscan(tstr,break);
for obj←1 thru numobj do
begin "ALLOBJS"
s← $ new;
put s in blobs;
tstr←input(file,lot);
number←intscan(tstr,break);
BEGIN "VLR"
safe itemvar array verts[1:number];
sym←-1;
for i←1 step 1 until number do
⊂ "GPOINTS"
gv ← $ new(size7);
α strn←"V"&cvs(sym←sym+1)&"."&cvs(obj);
α new_pname(gv,strn);
tstr←input(file,lot);
$ ∂(gv)[1] ← realscan(tstr,break);
$ ∂(gv)[2] ← realscan(tstr,break);
verts[i]←gv;
$ make point⊗s≡gv ⊃ "GPOINTS";
type "GLOBAL POINTS" eom;
sym←-1;
tstr←input(file,lot);
ii←intscan(tstr,break);
for i←1 step 1 until ii do
⊂ "GLINES"
INTEGER IIII,JJJJ;
α strn←"L"&cvs(sym←sym+1)&"."&cvs(obj);
tstr←input(file,lot);
gl←$ new(realscan(tstr,break));
$ make line⊗s≡gl;
iiii←intscan(tstr,break);
jjjj←intscan(tstr,break);
gt←verts[IIII];
gh←verts[JJJJ];
$ make endpt⊗gl≡gt;
$ make endpt⊗gl≡gh ⊃ "GLINES";
TYPE "GLOBAL LINES" EOM;
sym←-1;
tstr←input(file,lot);
numreg←intscan(tstr,break);
for i←1 step 1 until numreg do
⊂ "GREGIONS"
tstr←input(file,lot);
gr←$ new;
α strn←"R"&cvs(sym←sym+1)&"."&cvs(obj);
α new_pname(gr,strn);
if i=1
then $ make background⊗s≡gr;
$ make region⊗s≡gr;
peri←$ new(list0);
$ make perimeter⊗gr≡peri;
paths←intscan(tstr,break);
for j←1 step 1 until paths do
$ ∂(peri)[j]←verts[intscan(tstr,break)];
⊃ "GREGIONS";
type "GLOBAL REGIONS" eom;
END "VLR";
tstr←input(file,lot);
ii←intscan(tstr,break);
for i←1 step 1 until ii do
⊂ "DANGLES"
tstr←input(file,lot);
gl←$ new(0.0);
gt←$ new(size7);
gh←$ new(size7);
$ make dangle⊗s≡gl;
$ make endpt⊗gl≡gt;
$ make endpt⊗gl≡gh;
$ ∂(gt)[1]←realscan(tstr,break);
$ ∂(gt)[2]←realscan(tstr,break);
$ ∂(gh)[1]←realscan(tstr,break);
$ ∂(gh)[2]←realscan(tstr,break);
⊃ "DANGLES";
end "ALLOBJS";
tstr←input(file,lot);
ii←intscan(tstr,break);
if ii
then ⊂ "GET XFORM"
for i←1 thru 10 do
⊂ tstr←input(file,lot);
for j←1 thru 3 do
camary[i,j]←realscan(tstr,break) ⊃;
xf←$ new(camary);
$ make xform⊗s≡xf;
⊃ "GET XFORM";
release(file);
END "DATA MAKER";
α DISKOUT
if this job is run by itself, ask if an ascii output file
of the results is desired. ( ext=".SEG" ];
INTERNAL PROCEDURE DISKOUT;
BEGIN "DISKOUT"
DEFINE PRINT=<OUT(1,>,
BLANK=<OUT(1,'12&'15);>,
SEPARATE=<OUT(1,↓&↓&↓);>,
SPACE=<" ">,
___=<);>,
SKIP=<&↓&↓&↓>,
!=<&'12&'15);>;
SET PSET;
SAFE REAL ARRAY ITEMVAR GP,XF;
ITEMVAR GB,GC,GF,GL,GP2;
INTEGER I,BREAK,EOF;
STRING ANS,FILENAME;
TYPE "WOULD YOU LIKE A ASCII DISK FILE OF SEGMENT'S BODIES??" EOM;
ANS←INCHWL;
IF ANS="Y" ∨ ANS="y"
THEN BEGIN "OUTPUT"
OPEN(1,"DSK",0,0,2,120,BREAK,EOF);
DO ⊂ TYPE "FILE NAME ← " EOM;
FILENAME←INCHWL;
ENTER(1,FILENAME,I);
IF I
THEN TYPE "ENTER FAILED!" EOM ⊃ UNTIL ¬I;
PRINT "NUMBER OF BODIES = "&CVS(LENGTH($ BODY⊗SCENE)) SKIP !
I←0;
∀ GB|$ BODY⊗SCENE≡GB DO
⊂ "OUT A BODY"
I←I+1;
PRINT "BODY"&CVS(I)&":"&TAB&PRINTNAME(GB) !
PRINT TAB&"NUMBER OF POINTS = "&CVS(LENGTH($ POINT⊗GB)) !
∀ GP|$ POINT⊗GB≡GP DO
PRINT TAB&TAB&PRINTNAME(GP)&
TAB&TAB&CVG($ ∂(GP)[1])&
SPACE&CVG($ ∂(GP)[2])&
SPACE&CVG($ ∂(GP)[3])&
SPACE&CVG($ ∂(GP)[4]) ! BLANK
PRINT TAB&"NUMBER OF LINES (WITH ENDPTS) = "& CVS(LENGTH($ LINE⊗GB)) !
∀ GL|$ LINE⊗GB≡GL DO
⊂ PSET←($ ENDPT⊗GL);
PRINT TAB&TAB&PRINTNAME(GL)&
TAB&TAB&PRINTNAME( LOP(PSET) )&
SPACE&PRINTNAME( COP(PSET) ) ! ⊃; BLANK
PRINT TAB&"NUMBER OF FACES (WITH BOUNDARIES) = "&
CVS(LENGTH($ FACE⊗GB)) !
∀ GF|$ FACE⊗GB≡GF DO
⊂ PRINT TAB&TAB&PRINTNAME(GF)&TAB&TAB ___
∀ GL|$ BOUNDARY⊗GF≡GL DO
PRINT SPACE&PRINTNAME(GL) ___ BLANK ⊃;
SEPARATE
⊃ "OUT A BODY";
PRINT "NUMBER OF OCCLUDERS = "&CVS(LENGTH($ OCCLUDER⊗ANY)) !
∀ GB,GC|$ OCCLUDER⊗GB≡GC DO
PRINT "OCCLUDER⊗"&PRINTNAME(GB)&"≡"&PRINTNAME(GC) !
SEPARATE
PRINT "NUMBER OF ABOVES = "&CVS(LENGTH($ ABOVE⊗ANY)) !
∀ GB,GC|$ ABOVE⊗GB≡GC DO
PRINT "ABOVE⊗"&PRINTNAME(GB)&"≡"&PRINTNAME(GC) !
SEPARATE
PRINT "TRANSFORM FOR SCENE:" !
ASSIGN XF|$ XFORM⊗SCENE≡XF HOLDS;
FOR I←1 STEP 1 UNTIL 10 DO
⊂ PRINT TAB ___
FOR J←1 STEP 1 UNTIL 3 DO PRINT CVG($ ∂(XF)[I,J]) ___
BLANK ⊃;
RELEASE(1);
END "OUTPUT";
END "DISKOUT";
α ANGLE
returns the angle in degrees of the angle formed by p1,p2,p3.
DIMS is the number of dimensions of the point.
;
INTERNAL REAL PROCEDURE ANGLE(SAFE REAL ARRAY ITEM P1,P2,P3;INTEGER
DIMS);
BEGIN
SAFE REAL ARRAY V1,V2[1:3];
INTEGER I;REAL MSV1,MSV2,X,DOTT;
DOTT←MSV1←MSV2←0.0;
IF DIMS=3 THEN
FOR I←1 S1U 3 DO
BEGIN
V1[I]←∂(P1)[I+2]-∂(P2)[I+2];
V2[I]←∂(P3)[I+2]-∂(P2)[I+2];
DOTT←DOTT+V1[I]*V2[I];
MSV1←MSV1+V1[I]↑2;
MSV2←MSV2+V2[I]↑2;
END
ELSE IF DIMS=2 THEN
FOR I←1 S1U 2 DO
BEGIN
V1[I]←∂(P1)[I]-∂(P2)[I];
V2[I]←∂(P3)[I]-∂(P2)[I];
DOTT←DOTT+V1[I]*V2[I];
MSV1←MSV1+V1[I]↑2;
MSV2←MSV2+V2[I]↑2;
END
ELSE IF DIMS=4 THEN
FOR I←1 S1U 3 DO
BEGIN
V1[I]←∂(P1)[I]-∂(P2)[I];
V2[I]←∂(P3)[I]-∂(P2)[I];
DOTT←DOTT+V1[I]*V2[I];
MSV1←MSV1+V1[I]↑2;
MSV2←MSV2+V2[I]↑2;
END
ELSE TYPE "WRONG NUMBER OF DIMENSIONS TO PROCEDURE ANGLE." EOM;
X←DOTT/SQRT(MSV1*MSV2);
X←57.3*ACOS(X);
RETURN(X);
END;
α VERT, DIST, PARALLEL
VERT - is edge E approx vertical in the projection?
DIST - returns the image distance between two points in raster units.
PARALLEL - returns true if 2 lines are parallel in the projection.
;
INTERNAL BOOLEAN PROCEDURE VERT(ITEMVAR E);
BEGIN "VERT"
SAFE REAL ARRAY ITEMVAR P1,P2;
SET ES;
REAL VERLEN,VERTOL;
ES←(ENDPT⊗E);
P1←LOP(ES);
P2←COP(ES);
ES←PHI;
VERLEN←SQRT((∂(P1)[2]-∂(P2)[2])↑2);
VERTOL←0.2*VERLEN;
IF VERLEN<35.0
THEN IF SQRT((∂(P1)[1]-∂(P2)[1])↑2)<2*VERTOL
THEN RETURN (TRUE);
IF SQRT((∂(P1)[1]-∂(P2)[1])↑2)<VERTOL
THEN RETURN (TRUE)
ELSE RETURN (FALSE);
END "VERT";
INTERNAL REAL PROCEDURE DIST(SAFE REAL ARRAY ITEMVAR P1,P2);
BEGIN "DIST"
REAL X;
X←SQRT( (∂(P1)[1]-∂(P2)[1])↑2+
(∂(P1)[2]-∂(P2)[2])↑2);
RETURN (X);
END "DIST";
INTERNAL BOOLEAN PROCEDURE PARALLEL(ITEMVAR L1,L2);
BEGIN "PARALLEL"
SET S; SAFE REAL ARRAY ITEMVAR X,Y,Z,W; REAL SLOPE1,SLOPE2;
IF VERT(L1) ∧ VERT(L2)
THEN RETURN (TRUE);
S←ENDPT⊗L1;
X←LOP(S);
Y←COP(S);
S←ENDPT⊗L2;
Z←LOP(S);
W←COP(S);
S←PHI;
SLOPE1←(∂(X)[2]-∂(Y)[2])/(∂(X)[1]-∂(Y)[1]);
SLOPE2←(∂(Z)[2]-∂(W)[2])/(∂(Z)[1]-∂(W)[1]);
IF 57.3*ABS(ATAN(SLOPE1)-ATAN(SLOPE2))<15.0
THEN RETURN (TRUE)
ELSE RETURN (FALSE);
END "PARALLEL";
α COLINEAR
determines if two lines are colinear by measuring
the error of the inner endpoints from the line defined by
the outer endpoints of U and V.
;
INTERNAL BOOLEAN PROCEDURE COLINEAR(ITEMVAR U,V);
BEGIN "COLINEAR"
SET S,S1,S2;
SAFE REAL ARRAY ITEMVAR X,Y,W,Z,PU,PV;
REAL A,B,C,D,DIST1,DIST2,UDIST,
VDIST,TDIST,ERROR,UERROR,VERROR;
DEFINE
XX(Z)=<∂(Z)[1]>,
YY(Z)=<∂(Z)[2]>,
EQUATION(Z)=<ABS(A*XX(Z) + B*YY(Z) +C)>;
S1←ENDPT⊗U;
S2←ENDPT⊗V;
S←S1∩S2;
IF S≠PHI
THEN BEGIN
W←Y←COP(S);
X←COP(S1 - S);
Z←COP(S2 - S);
END
ELSE BEGIN
X←LOP(S1);
Y←COP(S1);
DIST1←DIST(X,Y);
Z←LOP(S2);
W←COP(S2);
DIST2←DIST(Z,W);
IF DIST2>DIST1
THEN BEGIN
X↔Z;
Y↔W;
END;
IF DIST(Z,X)<DIST(W,X)
THEN Z↔W;
IF DIST(X,W)<DIST(Y,W)
THEN X↔Y;
END;
PU←X;
PV←Z;
α NOW GET THE SLOPE AND EQUATION OF LINE PU→PV
A*X + B*Y + C = 0 WHERE A,B ARE NORMALIZED COEFFS;
A←YY(PU)-YY(PV);
B←XX(PV)-XX(PU);
D←SQRT(A↑2 + B↑2);
A←A/D;
B←B/D;
C← - A*XX(PU) - B*YY(PU);
UDIST←DIST(X,Y);
VDIST←DIST(W,Z);
TDIST←UDIST MIN VDIST;
UERROR←EQUATION(Y);
VERROR←EQUATION(W);
ERROR←.25*TDIST/2;
IF UERROR≤ERROR ∧ VERROR≤ERROR
THEN BEGIN
TYPE "COLINEAR - "&PRINTNAME(U)&" "&PRINTNAME(V) EOM;
TYPE TAB&"TRUE"&CVG(UERROR/ERROR)&CVG(VERROR/ERROR) EOM;
RETURN(TRUE);
END
ELSE BEGIN
α TYPE TAB&"FALSE"&CVG(UERROR/ERROR)&CVG(VERROR/ERROR) EOM;
RETURN(FALSE);
END;
END "COLINEAR";
α TJOINTS
;
INTERNAL BOOLEAN PROCEDURE TJOINTS(SAFE REAL ARRAY ITEMVAR X;STRING STR);
BEGIN "TJOINTS"
INTEGER I;
SET S;
ITEMVAR ARRAY IVA[1:3,1:2];
SAFE REAL ARRAY ITEMVAR U,V,P1,P2;
SET ITEMVAR SIV;
ITEMVAR L,R;
S←ENDPT`X;
IF LENGTH(S)≠3
THEN BEGIN
S←PHI;
RETURN (FALSE);
END;
IVA[1,1]←IVA[2,1]←LOP(S);
IVA[1,2]←IVA[3,1]←LOP(S);
IVA[2,2]←IVA[3,2]←COP(S);
FOR I←1 S1U 3 DO
BEGIN "T2"
LABEL LAB1;
U←IVA[I,1];
V←IVA[I,2];
IF COLINEAR(U,V)
THEN BEGIN "T3"
L←COP(ENDPT`X-{U,V});
IF ¬EQU(STR,"NOMAKE")
THEN BEGIN "T4"
ASSIGN R|CORNER⊗R≡X ∧ (¬BOUNDARY⊗R≡L) HOLDS;
TYPE PRINTNAME(R) EOM;
IF R=BACK
THEN BEGIN "T5"
MAKE FLAVOR⊗X≡BADT;
PUT X IN SOP;
PUT L IN TSTEMS;
MAKE T_STEM⊗X≡L;
TTOPS←TTOPS∪{U,V};
S←PHI;
RETURN (TRUE);
END "T5";
MAKE FLAVOR⊗X≡TJOINT;
SIV←NEW(PHI);
∂(SIV)←{U,V};
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡X;
PUT X IN SOP;
MAKE NFLAVOR⊗SIV≡TJOINT;
END "T4";
PUT L IN TSTEMS;
MAKE T_STEM⊗X≡L;
TTOPS←TTOPS∪{U,V};
MAKE OCCLUDER⊗L≡U;
S←PHI;
RETURN(TRUE);
END "T3";
LAB1:
END "T2";
S←PHI;
RETURN (FALSE);
END "TJOINTS";
α ARROWS
;
INTERNAL BOOLEAN PROCEDURE ARROWS(SAFE REAL ARRAY ITEMVAR X);
BEGIN "ARROWS"
ITEMVAR L1,L2,L3;
SAFE REAL ARRAY ITEMVAR P1,P2,P3;
SAFE REAL ARRAY VL1,VL2,VL3[1:3];
INTEGER I;
REAL VL1XVL2,VL1XVL3;
SET ITEMVAR SIV;
REAL A1,A2;
SET S;
S←ENDPT`X;
IF LENGTH(S)≠3
THEN BEGIN "A1"
S←PHI;RETURN(FALSE);
END "A1";
∀ L1,L2,L3| ENDPT⊗L1≡X ∧ ENDPT⊗L2≡X ∧ (L1≠L2) ∧ ENDPT⊗L3≡X ∧
(L2≠L3) ∧ (L1≠L3) DO
BEGIN "A2"
P1←COP(ENDPT⊗L1-{X});
P2←COP(ENDPT⊗L2-{X});
P3←COP(ENDPT⊗L3-{X});
FOR I←1 S1U 3 DO
BEGIN "A3"
VL1[I]←∂(P1)[I]-∂(X)[I];
VL2[I]←∂(P2)[I]-∂(X)[I];
VL3[I]←∂(P3)[I]-∂(X)[I];
END "A3";
VL1XVL2←VL1[1]*VL2[2]-VL1[2]*VL2[1];
VL1XVL3←VL1[1]*VL3[2]-VL1[2]*VL3[1];
IF VL1XVL2*VL1XVL3>0
THEN BEGIN "A4"
A1←ANGLE(P1,X,P2,2);
A2←ANGLE(P1,X,P3,2);
IF A1>A2 THEN L2↔L3;
PUT L2 IN SHAFTS;
α IF BACKεBOUNDARY`L2 ∨ (L2εKTOPS);
IF (L2εKTOPS)
THEN BEGIN "A5"
MAKE FLAVOR⊗X≡BADARO;
MAKE OCCLUDER⊗L2≡L1;
PUT X IN SOP;
S←PHI;
RETURN (TRUE);
END "A5";
MAKE FLAVOR⊗X≡ARROW;
SIV←NEW(PHI);
∂(SIV)←ENDPT`X;
MAKE NMATCH⊗SIV≡X;
MAKE NODE⊗GRAPH≡SIV;
MAKE NFLAVOR⊗SIV≡ARROW;
PUT X IN SOP;
S←PHI;
RETURN(TRUE);
END "A4";
END "A2";
S←PHI;
RETURN(FALSE);
END "ARROWS";
α WHYS
;
INTERNAL BOOLEAN PROCEDURE WHYS(SAFE REAL ARRAY ITEMVAR X);
BEGIN "WHYS"
ITEMVAR L,L1,L2,L3,R;
SAFE REAL ARRAY ITEMVAR P1,P2,P3;
SAFE REAL ARRAY VL1,VL2,VL3[1:3];
INTEGER I;
REAL VL1XVL2,VL1XVL3;
SET ITEMVAR SIV;
IF LENGTH(ENDPT`X)≠3
THEN RETURN (FALSE);
∀ L1,L2,L3|ENDPT⊗L1≡X ∧ ENDPT⊗L2≡X ∧ (L1≠L2) ∧
ENDPT⊗L3≡X ∧ (L2≠L3) ∧ (L1≠L3) DO
BEGIN "W2"
P1←COP(ENDPT⊗L1-{X});
P2←COP(ENDPT⊗L2-{X});
P3←COP(ENDPT⊗L3-{X});
FOR I←1 S1U 3 DO
BEGIN "W3"
VL1[I]←∂(P1)[I]-∂(X)[I];
VL2[I]←∂(P2)[I]-∂(X)[I];
VL3[I]←∂(P3)[I]-∂(X)[I];
END "W3";
VL1XVL2←VL1[1]*VL2[2]-VL1[2]*VL2[1];
VL1XVL3←VL1[1]*VL3[2]-VL1[2]*VL3[1];
IF VL1XVL2*VL1XVL3>0
THEN RETURN (FALSE);
END "W2";
BOOL←FALSE;
∀ L|ENDPT⊗L≡X DO
IF LεSHAFTS THEN BOOL←TRUE;
IF BOOL
THEN BEGIN "W4"
MAKE FLAVOR⊗X≡GOODY;
SIV←NEW(PHI);
∂(SIV)←ENDPT`X;
MAKE NMATCH⊗SIV≡X;
MAKE NODE⊗GRAPH≡SIV;
MAKE NFLAVOR⊗SIV≡GOODY;
PUT X IN SOP;
RETURN(TRUE);
END "W4";
MAKE FLAVOR⊗X≡BADY;
PUT X IN SOP;
RETURN (TRUE);
END "WHYS";
α CONVEX
;
BOOLEAN PROCEDURE CONVEX(SAFE REAL ARRAY ITEMVAR V);
BEGIN "CONVEX"
DEFINE
XX(Z)=<∂(Z)[1]>,YY(Z)=<∂(Z)[2]>,
EQUA(Z)=< (A1*XX(Z)+B1*YY(Z)+C1) >,
EQUB(Z)=< (A2*XX(Z)+B2*YY(Z)+C2) >;
SAFE REAL ARRAY ITEMVAR VA,VB,VAA,VBB;
REAL X1,Y1,A1,A2,B1,B2,C1,C2,D,ANSA,ANSB,NUMA,NUMB;
ITEMVAR LA,LB,LAA,LBB;
BOOLEAN LESSP,GREATERP,BOOLA,BOOLB;
SET S,SA,SB;
α LA is one L arm
LB is the other
V is the L
VA is the other vertex of LA
VB is the other vertex of LB
LAA is the other line of VA
LBB is the other line of VB
VAA is the other vertex of LAL
VBB is the other vertex of LBL
X1,Y1 specify a point within the L
test: VAA must be on the same side of LA as (X1,Y1) ∧
VBB must be on the same side of LB as (X1,Y1)
;
S←ENDPT`V;
LA←LOP(S);
LB←COP(S);
VA←COP(ENDPT⊗LA - {V});
VB←COP(ENDPT⊗LB - {V});
X1←(0.04*∂(VA)[1]+0.04*∂(VB)[1]+1.92*∂(V)[1])/2.0;
Y1←(0.04*∂(VA)[2]+0.04*∂(VB)[2]+1.92*∂(V)[2])/2.0;
α first, see if the vertex is convex on the A side;
A1←YY(VA)-YY(V);
B1←XX(V)-XX(VA);
D←SQRT(A1↑2 + B1↑2);
A1←A1/D;
B1←B1/D;
C1← - A1*XX(V) - B1*YY(V);
α determine which side of A arm the X1,Y1 point is on;
ANSA← (A1*X1+B1*Y1+C1);
BOOLA←FALSE;
LAA←NIL;
SA←ENDPT`VA - {LA};
SELECT LAA|LAAεSA ∧ (¬(LAA ε TSTEMS)) WINS;
IF LAA=NIL
THEN RETURN(FALSE);
VAA←COP(ENDPT⊗LAA - {VA});
NUMA←EQUA(VAA);
IF ANSA<0 ∧ NUMA≤0
THEN BOOLA←TRUE
ELSE IF ANSA>0 ∧ NUMA≥0
THEN BOOLA←TRUE
ELSE BOOLA←FALSE;
α now check the B side;
A2←YY(VB)-YY(V);
B2←XX(V)-XX(VB);
D←SQRT(A2↑2 + B2↑2);
A2←A2/D;
B2←B2/D;
C2← - A2*XX(V) - B2*YY(V);
ANSB← (A2*X1+B2*Y1+C2);
LBB←NIL;
BOOLB←FALSE;
SB←ENDPT`VB - {LB};
SELECT LBB|LBBεSB ∧ (¬(LBB ε TSTEMS)) WINS;
IF LBB=NIL
THEN RETURN(FALSE);
VBB←COP(ENDPT⊗LBB - {VB});
NUMB←EQUB(VBB);
IF ANSB<0 ∧ NUMB≤0
THEN BOOLB←TRUE
ELSE IF ANSB>0 ∧ NUMB≥0
THEN BOOLB←TRUE
ELSE BOOLB←FALSE;
α if BOOLA ∨ BOOLB then probably a GOODL;
IF BOOLA ∨ BOOLB
THEN RETURN(TRUE)
ELSE RETURN(FALSE);
END "CONVEX";
α ELZ
;
INTERNAL BOOLEAN PROCEDURE ELZ(SAFE REAL ARRAY ITEMVAR X);
BEGIN "ELZ"
BOOLEAN BOOL1,BOOL2;
STRING ITEMVAR EXPL;
ITEMVAR L1,L2,LX,LY;
SAFE REAL ARRAY ITEMVAR P1,P2,V1,V2;
INTEGER I,N;
SET ITEMVAR SIV;SET S;
α a GOODL is a non interior vertex which is convex
with respect to the vertices at the ends of its arms....;
S←ENDPT`X;
IF LENGTH(S)≠2
THEN BEGIN "E1"
RETURN(FALSE);
END "E1";
PUT X IN SOP;
L1←LOP(S);
L2←COP(S);
BOOL1←BOOL2←FALSE;
IF BOOL2←COLINEAR(L1,L2) ∨
(LENGTH ((CORNER`X)-{BACK})=1 ∧ BOOL1←CONVEX(X))
THEN BEGIN "GOODL"
MAKE FLAVOR⊗X≡GOODL;
SIV←NEW(PHI);
∂(SIV)←ENDPT`X;
MAKE NMATCH⊗SIV≡X;
MAKE NFLAVOR⊗SIV≡GOODL;
MAKE NODE⊗GRAPH≡SIV;
IF BOOL2
THEN EXPL←NEW("COLINEAR")
ELSE IF BOOL1
THEN EXPL←NEW("CONVEX");
MAKE REASON⊗X≡EXPL;
RETURN (TRUE);
END "GOODL"
ELSE BEGIN "BADL"
MAKE FLAVOR⊗X≡BADL;
RETURN (TRUE);
END "BADL";
END "ELZ";
α XZANDKZ
;
INTERNAL BOOLEAN PROCEDURE XZANDKZ(SAFE REAL ARRAY ITEMVAR X);
BEGIN "XZANDKZ"
SET S1,S2,S3,VSET,LSET;
ITEMVAR A,B,C,D,LL;
SAFE REAL ARRAY ITEMVAR VV,VA,VB,VC,VD,X1,XX1,CC,DD;
BOOLEAN BOOL1,KBOOL,XBOOL;
INTEGER IGNORE;
SAFE REAL ARRAY V1,V2,V3[1:3];
REAL V2XV1,V3XV1;
SET ITEMVAR SIV,SIV1;
STRING STR;
α K_JOINT
if both cross products point in the same direction, we have a KJOINT;
INTERNAL PROCEDURE K_JOINT;
BEGIN "KJOINT"
IGNORE←FALSE;
α see if A line is the TSTEM for a TJOINT...;
IF FLAVOR⊗VA≡BADT ∧ AεTSTEMS
THEN
ELSE IGNORE←TRUE;
α make the same test for the other colinear line B and its outside vertex VB;
IF FLAVOR⊗VB≡BADT ∧ BεTSTEMS
THEN
ELSE IGNORE←TRUE;
α as we said, this is a KJOINT;
MAKE FLAVOR⊗X≡KJOINT;
SIV←NEW(PHI);
∂(SIV)←{A,B};
KTOPS←KTOPS∪{A,B};
α add a node to the graph (augment the set KTOPS);
KBOOL←TRUE;
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡X;
MAKE NFLAVOR⊗SIV≡KJOINT;
SIV←NEW(PHI);
X1←NIL;
α select the outside vertex (of the colinear lines) that was
found to be a TJOINT and therefore a BADT (if any);
IF FLAVOR⊗VA≡BADT ∧ AεTSTEMS
THEN X1←A
ELSE IF FLAVOR⊗VB≡BADT ∧ BεTSTEMS
THEN X1←B;
IF X1=NIL
THEN BEGIN "KJ3"
α none was found...so a new node is needed to hold the non-colinear
vertex lines;
∂(SIV)←{C,D};
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡X;
MAKE NFLAVOR⊗SIV≡KJOINT;
S1←S2←S3←PHI;
RETURN;
END "KJ3";
α the BADT indicates that a doublicate (sic) line must be added
to the structure...doublicate the line that had the BADT...;
STR←PRINTNAME(X1)&"badt";
XX1←NEW(0.0);NEW_PNAME(XX1,STR);
α ...it needs ENDPTs...;
∀ Y| ENDPT⊗X1≡Y DO MAKE ENDPT⊗XX1≡Y;
α ...make the new line part of the BOUNDARY of a few regions...;
∀ Y|BOUNDARY⊗Y≡X1 DO MAKE BOUNDARY⊗Y≡XX1;
α ...put the line and its doublicate into the set DOUBLE...;
DOUBLE←DOUBLE∪{X1,XX1};
α ...add the line to the scene (LOCAL data structure)...;
MAKE LINE⊗SCENE≡XX1;
α ...add a node to the graph...;
∂(SIV)←{C,D,XX1};
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡X;
α ...seems like it should be an ARROW, shouldn't it ??;
MAKE NFLAVOR⊗SIV≡KJOINT;
S1←S2←S3←PHI;
RETURN;
END "KJOINT";
α X_JOINT
ah, we seem to have an (GOOD)(BAD)X...
(cross products in opposite directions)
(set BOOL1 indicator before considering line C);
INTERNAL PROCEDURE X_JOINT;
BEGIN "XJOINT"
BOOLEAN SBOOL;
SET VSET,LSET,LNSET;
SAFE REAL ARRAY ITEMVAR VN,VV;
REAL ITEMVAR LN;
ITEMVAR LL,LX,NX,R,R1,LL1,LL2;
IGNORE←0;
BOOL1←FALSE;
VSET←{VC,VD};
LSET←{C,D};
FOR I←1,2 DO
BEGIN "XJ1"
VV←LOP(VSET);
LL←LOP(LSET);
α is the out vertex of a non-colinear line a TJOINT ??...;
IF FLAVOR⊗VV≡BADT
THEN BEGIN "COND1"
ASSIGN LX|T_STEM⊗VV≡LX HOLDS;
IF LL=LX
THEN BEGIN "SPLIT"
TYPE "XJOINT - TYPE 1: "&PRINTNAME(VV) EOM;
α ...undo what was done for VV...;
REMOVE LX FROM TSTEMS;
ERASE FLAVOR⊗VV≡BADT;
ERASE T_STEM⊗VV≡LX;
ERASE OCCLUDER⊗LX≡ANY;
TTOPS←TTOPS-(ENDPT`VV-{LX});
REMOVE VV FROM SOP;
α ...create a new line and new point and add to data structure...;
VN←NEW(SIZE7);NEW_PNAME(VN,GENSYM(NEWP));
ARRTRAN(∂(VN),∂(VV));
LN←NEW(0.0);NEW_PNAME(LN,GENSYM(NEWL));
DOUBLE←DOUBLE∪{LN,LL};
MAKE ENDPT⊗LN≡VN;
MAKE ENDPT⊗LN≡X;
MAKE POINT⊗S≡VN;
MAKE LINE⊗S≡LN;
α ...add line and point to data structure...;
ASSIGN R|BOUNDARY⊗R≡A ∧ BOUNDARY⊗R≡LL HOLDS;
ASSIGN LL1|ENDPT⊗LL1≡VV ∧ BOUNDARY⊗R≡LL1 ∧
(LL1≠LL) HOLDS;
ERASE ENDPT⊗LL1≡VV;
MAKE ENDPT⊗LL1≡VN;
ERASE CORNER⊗R≡VV;
ERASE BOUNDARY⊗R≡LL;
MAKE CORNER⊗R≡VN;
MAKE BOUNDARY⊗R≡LN;
IGNORE←IGNORE+1;
END "SPLIT";
END "COND1";
IF FLAVOR⊗VV≡TJOINT
THEN BEGIN "COND2"
TYPE "XJOINT - TYPE 2: "&PRINTNAME(VV) EOM;
ASSIGN LX|T_STEM⊗VV≡LX HOLDS;
IF PARALLEL(LX,A)
THEN BEGIN "SPLT2"
α ...undo what was done for VV...;
REMOVE LX FROM TSTEMS;
ERASE FLAVOR⊗VV≡TJOINT;
ERASE T_STEM⊗VV≡LX;
ERASE OCCLUDER⊗LX≡ANY;
TTOPS←TTOPS-(ENDPT`VV-{LX});
REMOVE VV FROM SOP;
α ...create a new point and copy a line...;
VN←NEW(SIZE7);NEW_PNAME(VN,GENSYM(NEWP));
ARRTRAN(∂(VN),∂(VV));
LN←NEW(0.0);NEW_PNAME(LN,GENSYM(NEWL));
MAKE POINT⊗S≡VN;
MAKE LINE⊗S≡LN;
ASSIGN R|REGION⊗S≡R ∧
BOUNDARY⊗R≡LX ∧ BOUNDARY⊗R≡LL HOLDS;
ERASE BOUNDARY⊗R≡LL;
MAKE BOUNDARY⊗R≡LN;
ERASE CORNER⊗R≡VV;
MAKE CORNER⊗R≡VN;
ERASE ENDPT⊗LX≡VV;
MAKE ENDPT⊗LX≡VN;
MAKE ENDPT⊗LN≡X;
MAKE ENDPT⊗LN≡VN;
DOUBLE←DOUBLE∪{LL,LN};
IGNORE←IGNORE+1;
END "SPLT2";
END "COND2";
END "XJ1";
α NOW, create a new vertex to divide the XJOINT into
two three-line vertices...;
IF IGNORE≥1
THEN BEGIN "NEW V"
VN←NEW(SIZE7);
NEW_PNAME(VN,GENSYM(NEWP));
ARRTRAN(∂(VN),∂(X));
MAKE POINT⊗S≡VN;
ERASE ENDPT⊗A≡X;
MAKE ENDPT⊗A≡VN;
∀ R|BOUNDARY⊗R≡A DO
BEGIN
MAKE CORNER⊗R≡VN;
ERASE CORNER⊗R≡X;
∀ L|BOUNDARY⊗R≡L ∧ ENDPT⊗L≡X DO
BEGIN
ERASE ENDPT⊗L≡X;
MAKE ENDPT⊗L≡VN;
END;
END;
END "NEW V";
α ...if both colinear lines are vertical,
then add the ABOVE property;
IF VERT(A) ∧ VERT(B)
THEN IF ∂(VA)[7]>∂(VB)[7]
THEN MAKE ABOVE⊗B≡A
ELSE MAKE ABOVE⊗A≡B;
RETURN;
END "XJOINT";
α xzandkz - execution;
S1←S2←ENDPT`X;
α test: is this procedure any way at all applicable to this vertex??;
IF LENGTH(S1)<4
THEN BEGIN "XK1"
S1←S2←S3←PHI;
RETURN(FALSE);
END "XK1";
α must be...look at the lines that meat at this vertex;
∀ A,B|AεS1 ∧ BεS1 ∧ (A≠B) DO
IF COLINEAR(A,B)
THEN BEGIN "XK2"
α get the two non-colinear lines of this vertex;
S3←ENDPT`X-{A,B};
C←LOP(S3);
D←COP(S3);
α and the other two vertices of these non-colinear lines...
(plus the other vertex of one of the colinear lines);
VC←COP(ENDPT⊗C-{X});
VD←COP(ENDPT⊗D-{X});
X1←COP(ENDPT⊗B-{X});
FOR I←1 S1U 3 DO
α calculate the three vectors (pointing out from the vertex);
BEGIN "XK3"
V1[I]←∂(X1)[I]-∂(X)[I];
V2[I]←∂(VC)[I]-∂(X)[I];
V3[I]←∂(VD)[I]-∂(X)[I];
END "XK3";
α cross each of the non-colinear vectors with the one colinear vector;
V2XV1←V2[1]*V1[2]-V1[1]*V2[2];
V3XV1←V3[1]*V1[2]-V3[2]*V1[1];
VA←COP(ENDPT⊗A-{X});
VB←x1;
IGNORE←0;
IF V2XV1*V3XV1>0
THEN K_JOINT
ELSE X_JOINT;
DONE;
END "XK2";
α ignore x if VC or VD is not a TJOINT;
IF IGNORE
THEN BEGIN "IGNORE"
TYPE "XZANDKZ - "&PRINTNAME(A)&" "&PRINTNAME(B) EOM;
RETURN(TRUE);
END "IGNORE";
α it's not a KJOINT or XJOINT, ergo...;
PUT X IN SOP;
MAKE FLAVOR⊗X≡MULTI;
S1←S2←S3←PHI;
RETURN(TRUE);
END "XZANDKZ";
α INHIBIT
;
INTERNAL PROCEDURE INHIBIT;
COMMENT COMMENT IF TWO T-JOINTS SHARE A COMMON TTOP, ELIMINATE THIS
TOP FROM ALL NODE SETS IF THE TWO TSTEMS DO NOT BOUND A
COMMON REGION.;
BEGIN "INHIBIT"
INTEGER I;
ITEMVAR L,L1,L2;
SAFE REAL ARRAY X1,X2[1:3];
SAFE REAL ARRAY ITEMVAR U,V,U1,V1,R;
SET S1;
SET ITEMVAR X;
∀ L|LINE⊗S≡L DO
BEGIN "I1"
LABEL LAB1;
S1←ENDPT⊗L;
U←LOP(S1);
V←COP(S1);
IF FLAVOR⊗U≡TJOINT ∧ FLAVOR⊗V≡TJOINT ∧ (¬LεTSTEMS)
THEN BEGIN "I2"
∀ L1,L2,R| ENDPT⊗L1≡U ∧ ENDPT⊗L2≡V ∧ (L1≠L) ∧ (L2≠L) ∧
BOUNDARY⊗R≡L1 ∧ BOUNDARY⊗R≡L2 DO GO TO LAB1;
TYPE "INHIBITING "&PRINTNAME(L) EOM;
TYPE "L1 AND L2 ARE: "&PRINTNAME(L1)&" "&PRINTNAME(L2) EOM;
∀ X|NODE⊗GRAPH≡X DO
IF Lε∂(X)
THEN ∂(X)←∂(X)-{L};
END "I2";
LAB1:
END "I1";
S1←PHI;
RETURN;
END "INHIBIT";
α GOODTZ4BAD
;
COMMENT TO HANDLE MOST DEGENERATE VIEWS OF RPPS WE NEED REPLACE
SOME OF THE JOINTS LABELED BADT BY THE LABEL GOODA
BASED ON MORE GLOBAL INFORMATION.;
INTERNAL PROCEDURE GOODTZ4BAD;
BEGIN "GOODTZ4BAD"
ITEMVAR P,P1,P2,L,L1,L2,PX;
SET ITEMVAR SIV;SET S_FOO,NEWS;
TYPE "GOODTZ4BAD checking in..." EOM;
S_FOO←(FLAVOR ` BADT);
TYPE "there are "&cvs(length(s_foo))&" BADTs" EOM;
∀ p|POINT⊗s≡p ∧ FLAVOR⊗p≡BADT DO
BEGIN "G1"
LABEL LAB1;
ASSIGN L1|ENDPT⊗L1≡P ∧ (¬T_STEM⊗P≡L1) HOLDS;
ASSIGN L2|ENDPT⊗L2≡P ∧ (¬T_STEM⊗P≡L2) ∧ (L1≠L2) HOLDS;
P1←COP(ENDPT⊗L1-{P});
P2←COP(ENDPT⊗L2-{P});
IF (FLAVOR⊗P1≡GOODL ∨ FLAVOR⊗P1≡BADL) ∧
(FLAVOR⊗P2≡GOODL ∨ FLAVOR⊗P2≡BADL)
THEN BEGIN "G2"
ERASE FLAVOR⊗P≡BADT;
ERASE T_STEM⊗P≡ANY;
MAKE FLAVOR⊗P≡ARROW;
SIV←NEW(NEWS);
∂(SIV)←ENDPT`P;
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡P;
MAKE NFLAVOR⊗SIV≡ARROW;
TYPE "...changed one..." EOM;
GO TO LAB1;
END "G2";
PX←NIL;
IF (FLAVOR⊗P1≡BADT ∨ FLAVOR⊗P1≡TJOINT) ∧
(FLAVOR⊗P2≡BADL ∨ FLAVOR⊗P2≡GOODL)
THEN PX←P2
ELSE
IF (FLAVOR⊗P2≡BADT ∨ FLAVOR⊗P2≡TJOINT) ∧
(FLAVOR⊗P1≡GOODL ∨ FLAVOR⊗P1≡BADL)
THEN PX←P1;
IF PX≠NIL
THEN BEGIN "G3"
L←COP(ENDPT`PX-ENDPT`P);
PX←COP(ENDPT⊗L-{PX});
IF FLAVOR⊗PX≡GOODL ∨ FLAVOR⊗PX≡BADL
THEN BEGIN "G4"
ERASE FLAVOR⊗P≡BADT;
ERASE T_STEM⊗P≡ANY;
MAKE FLAVOR⊗P≡ARROW;
SIV←NEW(NEWS);
∂(SIV)←ENDPT`P;
MAKE NODE⊗GRAPH≡SIV;
MAKE NMATCH⊗SIV≡P;
MAKE NFLAVOR⊗SIV≡ARROW;
TYPE "...changed one..." EOM;
END "G4";
END "G3";
LAB1:
END "G1";
TYPE "goodtz4bad exit" EOM;
RETURN;
END "GOODTZ4BAD";
α MERGE_NODE
merge two nodes of the graph into one node
ERASE NODE Y - ADD TO NODE X
;
INTERNAL PROCEDURE MERGE_NODE(SET ITEMVAR Y,X);
BEGIN "MERGE"
ITEMVAR Z;
ERASE NODE⊗GRAPH≡Y;
ERASE NMATCH⊗Y≡ANY;
ERASE NFLAVOR⊗Y≡ANY;
ERASE LINK⊗X≡Y;
ERASE LINK⊗Y≡X;
∀ Z|LINK⊗Y≡Z ∧ (Z≠X) DO
BEGIN
MAKE LINK⊗X≡Z;
ERASE LINK⊗Y≡Z;
END;
∀ Z|LINK⊗Z≡Y DO
BEGIN
MAKE LINK⊗Z≡X;
ERASE LINK⊗Z≡Y;
END;
∂(X)← ∂(X) ∪ ∂(Y);
∀ Z|ABOVE⊗Y≡Z DO
BEGIN
ERASE ABOVE⊗Y≡Z;
MAKE ABOVE⊗X≡Z;
END;
∀ Z|ABOVE⊗Z≡Y DO
BEGIN
ERASE ABOVE⊗Z≡Y;
MAKE ABOVE⊗Z≡X;
END;
END "MERGE";
END "SEG0";